library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(plotly)
##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layout
income related constants
adult <- 4529
child <- 200
unemployed_factor <- 0.7
alimony <- c(0, 0.15, 0.25, 0.30) # alimony rate for 0, 1, 2, and 3 children
expenditure constants
a1c0 <- 3977
a2c0 <- 6605
a2c1 <- 7057
a2c2 <- 7635
a2c3 <- 7968
For single parent households there is no differentiating between number of children. Let’s use analoguous value from two parent households and scale accordingly after disentangling the costs for the adult and the children.
a1cx <- 5354.18
a2cx <- 7492.73
a1c1 <-a1c0 + (a2c1-a2c0)/(a2cx-a2c0)*(a1cx-a1c0)
a1c2 <-a1c0 + (a2c2-a2c0)/(a2cx-a2c0)*(a1cx-a1c0)
a1c3 <-a1c0 + (a2c3-a2c0)/(a2cx-a2c0)*(a1cx-a1c0)
create data frame with incomes
df_income <-crossing(
employment_level = c(1, 0.75, 0.5),
cohabiting_partner = c('none', 'working','not working'),
children = 0:3
) %>%
mutate(
income = adult * employment_level + child * children + case_when(
cohabiting_partner == 'not working' ~ adult * unemployed_factor,
cohabiting_partner == 'working' ~ adult,
cohabiting_partner == 'none' ~ adult * alimony[children+1]
),
adults = ifelse(cohabiting_partner == 'none', 1, 2)
)
create data frame with the expenditures
df_exp <- tibble(
adults = rep(1:2, each=4),
children = rep(0:3, 2)
) %>%
# get expenditure my name pattern
rowwise() %>%
mutate(
exp = get(paste0('a', adults, 'c', children))
)
join them and use the ratio of income to expenditure of a single person working full-time as reference to scale all other combinations
df_final <- df_income %>%
full_join(df_exp) %>%
mutate(
ratio = income/exp,
sufficiency = ratio/(adult/a1c0),
) %>%
arrange(cohabiting_partner, desc(employment_level))
## Joining with `by = join_by(children, adults)`
p <- df_final %>%
ggplot(aes(x=children, y=sufficiency, fill=sufficiency, text=paste0(
'income sufficiency:\n', round(sufficiency,3)
))) +
geom_col() +
facet_grid(employment_level ~ cohabiting_partner, labeller = labeller(
cohabiting_partner = function(string) {paste0('cohabiting partner:\n', string)},
employment_level = function(numeric) {paste0('employment:\n', as.numeric(numeric)*100,'%')}
)) +
guides(fill = 'none') +
theme_minimal() +
theme(plot.margin = margin(0.3,1,0.8,0.8, "cm")) +
scale_fill_continuous(type = "viridis")
pp <- ggplotly(p, tooltip = "text")
pp
api_create(pp, filename = "income_sufficiency")
## Found a grid already named: 'income_sufficiency Grid'. Since fileopt='overwrite', I'll try to update it
## Found a plot already named: 'income_sufficiency'. Since fileopt='overwrite', I'll try to update it